home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / sbin / cleanup-info < prev    next >
Text File  |  2008-09-03  |  5KB  |  181 lines
  1. #!/usr/bin/perl --
  2. #
  3. #   Clean up the mess that bogus install-info may have done :
  4. #
  5. #    - gather all sections with the same heading into a single one.
  6. #    Tries to be smart about cases and trailing colon/spaces.
  7. #
  8. #   Other clean ups :
  9. #
  10. #    - remove empty sections,
  11. #    - squeeze blank lines (in entries part only).
  12. #
  13. #   Order of sections is preserved (the first encountered section
  14. # counts).
  15. #
  16. #   Order of entries within a section is preserved.
  17. #
  18. # BUGS:
  19. #
  20. #   Probably many : I just recently learned Perl for this program
  21. # using the man pages.  Hopefully this is a short enough program to
  22. # debug.
  23.  
  24. use strict;
  25. use warnings;
  26.  
  27. use Dpkg;
  28. use Dpkg::Gettext;
  29.  
  30. textdomain("dpkg");
  31.  
  32. ($0) = $0 =~ m:.*/(.+):;
  33.  
  34. sub version {
  35.     printf _g("Debian %s version %s.\n"), $0, $version;
  36.  
  37.     printf _g("
  38. Copyright (C) 1996 Kim-Minh Kaplan.");
  39.  
  40.     printf _g("
  41. This is free software; see the GNU General Public Licence version 2 or
  42. later for copying conditions. There is NO warranty.
  43. ");
  44. }
  45.  
  46. sub usage {
  47.     printf _g(
  48. "Usage: %s [<option> ...] [--] [<dirname>]
  49.  
  50. Options:
  51.   --unsafe     set some additional possibly useful options.
  52.                warning: this option may garble an otherwise correct file.
  53.   --help       show this help message.
  54.   --version    show the version.
  55. "), $0;
  56. }
  57.  
  58. my $infodir = '/usr/info';
  59. my $unsafe = 0;
  60. $0 =~ m|[^/]+$|;
  61. my $name= $&;
  62.  
  63. sub ulquit {
  64.     unlink "$infodir/dir.lock"
  65.     or warn sprintf(_g("%s: warning - unable to unlock %s: %s"),
  66.                     $name, "$infodir/dir", $!)."\n";
  67.     die "$name: $_[0]";
  68. }
  69.  
  70. while (scalar @ARGV > 0 && $ARGV[0] =~ /^--/) {
  71.     $_ = shift;
  72.     /^--$/ and last;
  73.     /^--version$/ and do {
  74.     version;
  75.     exit 0;
  76.     };
  77.     /^--help$/ and do {
  78.     usage;
  79.     exit 0;
  80.     };
  81.     /^--unsafe$/ and do {
  82.     $unsafe=1;
  83.     next;
  84.     };
  85.     printf STDERR _g("%s: unknown option \`%s'")."\n", $name, $_;
  86.     usage;
  87.     exit 1;
  88. }
  89.  
  90. if (scalar @ARGV > 0) {
  91.     $infodir = shift;
  92.     if (scalar @ARGV > 0) {
  93.     printf STDERR _g("%s: too many arguments")."\n", $name;
  94.     usage;
  95.     exit 1;
  96.     }
  97. }
  98.  
  99. if (!link "$infodir/dir", "$infodir/dir.lock") {
  100.     die sprintf(_g("%s: failed to lock dir for editing! %s"),
  101.                 $name, $!)."\n".
  102.         ($! =~ /exist/i ? sprintf(_g("try deleting %s"),
  103.                                   "$infodir/dir.lock")."\n" : '');
  104. }
  105. open OLD, "$infodir/dir"
  106.     or ulquit sprintf(_g("unable to open %s: %s"), "$infodir/dir", $!)."\n";
  107. open OUT, ">$infodir/dir.new"
  108.     or ulquit sprintf(_g("unable to create %s: %s"), "$infodir/dir.new", $!)."\n";
  109.  
  110. my (%sections, @section_list, $lastline);
  111. my $section="Miscellaneous";    # default section
  112. my $section_canonic="miscellaneous";
  113. my $waitfor = $unsafe ? '^\*.*:' : '^\*\s*Menu';
  114.  
  115. while (<OLD>) {                # dump the non entries part
  116.     last if (/$waitfor/oi);
  117.     if (defined $lastline) {
  118.     print OUT $lastline
  119.         or ulquit sprintf(_g("unable to write %s: %s"),
  120.                  "$infodir/dir.new", $!)."\n";
  121.     }
  122.     $lastline = $_;
  123. };
  124.  
  125. if (/^\*\s*Menu\s*:?/i) {
  126.     print OUT $lastline if defined $lastline;
  127.     print OUT $_;
  128. } else {
  129.     print OUT "* Menu:\n";
  130.     if (defined $lastline) {
  131.     $lastline =~ s/\s*$//;
  132.     if ($lastline =~ /^([^\*\s].*)/) { # there was a section title
  133.         $section = $1;
  134.         $lastline =~ s/\s*:$//;
  135.         $section_canonic = lc $lastline;
  136.     }
  137.     }
  138.     push @section_list, $section_canonic;
  139.     s/\s*$//;
  140.     $sections{$section_canonic} = "\n$section\n$_\n";
  141. }
  142.  
  143. foreach (<OLD>) {        # collect sections
  144.     next if (/^\s*$/ or $unsafe and /^\*\s*Menu/oi);
  145.     s/\s*$//;
  146.     if (/^([^\*\s].*)/) {        # change of section
  147.     $section = $1;
  148.     s/\s*:$//;
  149.     $section_canonic = lc $_;
  150.     } else {            # add to section
  151.     if (! exists $sections{$section_canonic}) { # create section header
  152.         push @section_list, $section_canonic;
  153.         $sections{$section_canonic} = "\n$section\n";
  154.     }
  155.     $sections{$section_canonic} .= "$_\n";
  156.     }
  157. }
  158.  
  159. eof OLD or ulquit sprintf(_g("unable to read %s: %s"), "$infodir/dir", $!)."\n";
  160. close OLD or ulquit sprintf(_g("unable to close %s after read: %s"),
  161.                                "$infodir/dir", $!)."\n";
  162.  
  163. print OUT @sections{@section_list};
  164. close OUT or ulquit sprintf(_g("unable to close %s: %s"),
  165.                                "$infodir/dir.new", $!)."\n";
  166.  
  167. # install clean version
  168. unlink "$infodir/dir.old";
  169. link "$infodir/dir", "$infodir/dir.old"
  170.     or ulquit sprintf(_g("unable to backup old %s, giving up: %s"),
  171.                          "$infodir/dir", $!)."\n";
  172. rename "$infodir/dir.new", "$infodir/dir"
  173.     or ulquit sprintf(_g("failed to install %s; it will be left as %s: %s"),
  174.                          "$infodir/dir", "$infodir/dir.new", $!)."\n";
  175.  
  176. unlink "$infodir/dir.lock"
  177.     or die sprintf(_g("%s: unable to unlock %s: %s"),
  178.                    $name, "$infodir/dir", $!)."\n";
  179.  
  180. exit 0;
  181.